<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html xmlns="http://www.w3.org/1999/xhtml"><head><link rel="stylesheet" type="text/css" href="style.css" /><script type="text/javascript" src="highlight.js"></script></head><body><pre><span class="hs-pragma">{-# LANGUAGE CPP #-}</span><span>
</span><span id="line-2"></span><span class="hs-pragma">{-# LANGUAGE FlexibleContexts #-}</span><span>
</span><span id="line-3"></span><span class="hs-pragma">{-# LANGUAGE RankNTypes #-}</span><span>
</span><span id="line-4"></span><span>
</span><span id="line-5"></span><span class="hs-keyword">module</span><span> </span><span class="hs-identifier">Distribution.Compat.CreatePipe</span><span> </span><span class="hs-special">(</span><span class="annot"><a href="../../process/src/System.Process.Internals.html#createPipe"><span class="hs-identifier">createPipe</span></a></span><span class="hs-special">)</span><span> </span><span class="hs-keyword">where</span><span class="hs-cpp">

#if MIN_VERSION_process(1,2,1)
</span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="../../process/src/System.Process.html#"><span class="hs-identifier">System.Process</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><a href="../../process/src/System.Process.Internals.html#createPipe"><span class="hs-identifier">createPipe</span></a></span><span class="hs-special">)</span><span class="hs-cpp">
#else
</span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">System.IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Handle</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">hSetBinaryMode</span><span class="hs-special">)</span><span>
</span><span id="line-11"></span><span>
</span><span id="line-12"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">Prelude</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-13"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">Distribution.Compat.Prelude</span><span>
</span><span id="line-14"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">Distribution.Compat.Stack</span><span>
</span><span id="line-15"></span><span>
</span><span id="line-16"></span><span class="hs-comment">-- The mingw32_HOST_OS CPP macro is GHC-specific</span><span class="hs-cpp">
#ifdef mingw32_HOST_OS
</span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">qualified</span><span> </span><span class="hs-identifier">Prelude</span><span>
</span><span id="line-19"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">Control.Exception</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">onException</span><span class="hs-special">)</span><span>
</span><span id="line-20"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">Foreign.C.Error</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">throwErrnoIfMinus1_</span><span class="hs-special">)</span><span>
</span><span id="line-21"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">Foreign.C.Types</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">CInt</span><span class="hs-special">(</span><span class="hs-glyph">..</span><span class="hs-special">)</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">CUInt</span><span class="hs-special">(</span><span class="hs-glyph">..</span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-22"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">Foreign.Ptr</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Ptr</span><span class="hs-special">)</span><span>
</span><span id="line-23"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">Foreign.Marshal.Array</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">allocaArray</span><span class="hs-special">)</span><span>
</span><span id="line-24"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">Foreign.Storable</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">peek</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">peekElemOff</span><span class="hs-special">)</span><span>
</span><span id="line-25"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.IO.FD</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">mkFD</span><span class="hs-special">)</span><span>
</span><span id="line-26"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.IO.Device</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">IODeviceType</span><span class="hs-special">(</span><span class="hs-identifier">Stream</span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-27"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.IO.Handle.FD</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">mkHandleFromFD</span><span class="hs-special">)</span><span>
</span><span id="line-28"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">System.IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">IOMode</span><span class="hs-special">(</span><span class="hs-identifier">ReadMode</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">WriteMode</span><span class="hs-special">)</span><span class="hs-special">)</span><span class="hs-cpp">
#elif defined ghcjs_HOST_OS
</span><span class="hs-cpp">#else
</span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">System.Posix.IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">fdToHandle</span><span class="hs-special">)</span><span>
</span><span id="line-32"></span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">qualified</span><span> </span><span class="hs-identifier">System.Posix.IO</span><span> </span><span class="hs-keyword">as</span><span> </span><span class="hs-identifier">Posix</span><span class="hs-cpp">
#endif
</span><span>
</span><span id="line-35"></span><span class="hs-identifier">createPipe</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Handle</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">Handle</span><span class="hs-special">)</span><span>
</span><span id="line-36"></span><span class="hs-comment">-- The mingw32_HOST_OS CPP macro is GHC-specific</span><span class="hs-cpp">
#ifdef mingw32_HOST_OS
</span><span class="hs-identifier">createPipe</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-39"></span><span>    </span><span class="hs-special">(</span><span class="hs-identifier">readfd</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">writefd</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">allocaArray</span><span> </span><span class="hs-number">2</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-glyph">\</span><span> </span><span class="hs-identifier">pfds</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-40"></span><span>        </span><span class="hs-identifier">throwErrnoIfMinus1_</span><span> </span><span class="hs-string">&quot;_pipe&quot;</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">c__pipe</span><span> </span><span class="hs-identifier">pfds</span><span> </span><span class="hs-number">2</span><span> </span><span class="hs-special">(</span><span class="hs-comment">{- _O_BINARY -}</span><span> </span><span class="hs-number">32768</span><span class="hs-special">)</span><span>
</span><span id="line-41"></span><span>        </span><span class="hs-identifier">readfd</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">peek</span><span> </span><span class="hs-identifier">pfds</span><span>
</span><span id="line-42"></span><span>        </span><span class="hs-identifier">writefd</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">peekElemOff</span><span> </span><span class="hs-identifier">pfds</span><span> </span><span class="hs-number">1</span><span>
</span><span id="line-43"></span><span>        </span><span class="hs-identifier">return</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">readfd</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">writefd</span><span class="hs-special">)</span><span>
</span><span id="line-44"></span><span>    </span><span class="hs-special">(</span><span class="hs-keyword">do</span><span> </span><span class="hs-identifier">readh</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">fdToHandle</span><span> </span><span class="hs-identifier">readfd</span><span> </span><span class="hs-identifier">ReadMode</span><span>
</span><span id="line-45"></span><span>        </span><span class="hs-identifier">writeh</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">fdToHandle</span><span> </span><span class="hs-identifier">writefd</span><span> </span><span class="hs-identifier">WriteMode</span><span>
</span><span id="line-46"></span><span>        </span><span class="hs-identifier">hSetBinaryMode</span><span> </span><span class="hs-identifier">readh</span><span> </span><span class="hs-identifier">True</span><span>
</span><span id="line-47"></span><span>        </span><span class="hs-identifier">hSetBinaryMode</span><span> </span><span class="hs-identifier">writeh</span><span> </span><span class="hs-identifier">True</span><span>
</span><span id="line-48"></span><span>        </span><span class="hs-identifier">return</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">readh</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">writeh</span><span class="hs-special">)</span><span class="hs-special">)</span><span> </span><span class="hs-special">`</span><span class="hs-identifier">onException</span><span class="hs-special">`</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">close</span><span> </span><span class="hs-identifier">readfd</span><span> </span><span class="hs-operator">&gt;&gt;</span><span> </span><span class="hs-identifier">close</span><span> </span><span class="hs-identifier">writefd</span><span class="hs-special">)</span><span>
</span><span id="line-49"></span><span>  </span><span class="hs-keyword">where</span><span>
</span><span id="line-50"></span><span>    </span><span class="hs-identifier">fdToHandle</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">CInt</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IOMode</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">Handle</span><span>
</span><span id="line-51"></span><span>    </span><span class="hs-identifier">fdToHandle</span><span> </span><span class="hs-identifier">fd</span><span> </span><span class="hs-identifier">mode</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-52"></span><span>        </span><span class="hs-special">(</span><span class="hs-identifier">fd'</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">deviceType</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">mkFD</span><span> </span><span class="hs-identifier">fd</span><span> </span><span class="hs-identifier">mode</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Just</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Stream</span><span class="hs-special">,</span><span> </span><span class="hs-number">0</span><span class="hs-special">,</span><span> </span><span class="hs-number">0</span><span class="hs-special">)</span><span class="hs-special">)</span><span> </span><span class="hs-identifier">False</span><span> </span><span class="hs-identifier">False</span><span>
</span><span id="line-53"></span><span>        </span><span class="hs-identifier">mkHandleFromFD</span><span> </span><span class="hs-identifier">fd'</span><span> </span><span class="hs-identifier">deviceType</span><span> </span><span class="hs-string">&quot;&quot;</span><span> </span><span class="hs-identifier">mode</span><span> </span><span class="hs-identifier">False</span><span> </span><span class="hs-identifier">Nothing</span><span>
</span><span id="line-54"></span><span>
</span><span id="line-55"></span><span>    </span><span class="hs-identifier">close</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">CInt</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-56"></span><span>    </span><span class="hs-identifier">close</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">throwErrnoIfMinus1_</span><span> </span><span class="hs-string">&quot;_close&quot;</span><span> </span><span class="hs-operator">.</span><span> </span><span class="hs-identifier">c__close</span><span>
</span><span id="line-57"></span><span>      </span><span class="hs-keyword">where</span><span> </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">callStack</span><span> </span><span class="hs-comment">-- TODO: attach call stack to exception</span><span>
</span><span id="line-58"></span><span>
</span><span id="line-59"></span><span>    </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">callStack</span><span> </span><span class="hs-comment">-- TODO: attach call stack to exceptions</span><span>
</span><span id="line-60"></span><span>
</span><span id="line-61"></span><span class="hs-keyword">foreign</span><span> </span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">ccall</span><span> </span><span class="hs-string">&quot;io.h _pipe&quot;</span><span> </span><span class="hs-identifier">c__pipe</span><span> </span><span class="hs-glyph">::</span><span>
</span><span id="line-62"></span><span>    </span><span class="hs-identifier">Ptr</span><span> </span><span class="hs-identifier">CInt</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CUInt</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CInt</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Prelude.IO</span><span> </span><span class="hs-identifier">CInt</span><span>
</span><span id="line-63"></span><span>
</span><span id="line-64"></span><span class="hs-keyword">foreign</span><span> </span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">ccall</span><span> </span><span class="hs-string">&quot;io.h _close&quot;</span><span> </span><span class="hs-identifier">c__close</span><span> </span><span class="hs-glyph">::</span><span>
</span><span id="line-65"></span><span>    </span><span class="hs-identifier">CInt</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Prelude.IO</span><span> </span><span class="hs-identifier">CInt</span><span class="hs-cpp">
#elif defined ghcjs_HOST_OS
</span><span class="hs-identifier">createPipe</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">error</span><span> </span><span class="hs-string">&quot;createPipe&quot;</span><span>
</span><span id="line-68"></span><span>  </span><span class="hs-keyword">where</span><span>
</span><span id="line-69"></span><span>    </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">callStack</span><span class="hs-cpp">
#else
</span><span class="hs-identifier">createPipe</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-72"></span><span>    </span><span class="hs-special">(</span><span class="hs-identifier">readfd</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">writefd</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">Posix.createPipe</span><span>
</span><span id="line-73"></span><span>    </span><span class="hs-identifier">readh</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">fdToHandle</span><span> </span><span class="hs-identifier">readfd</span><span>
</span><span id="line-74"></span><span>    </span><span class="hs-identifier">writeh</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">fdToHandle</span><span> </span><span class="hs-identifier">writefd</span><span>
</span><span id="line-75"></span><span>    </span><span class="hs-identifier">hSetBinaryMode</span><span> </span><span class="hs-identifier">readh</span><span> </span><span class="hs-identifier">True</span><span>
</span><span id="line-76"></span><span>    </span><span class="hs-identifier">hSetBinaryMode</span><span> </span><span class="hs-identifier">writeh</span><span> </span><span class="hs-identifier">True</span><span>
</span><span id="line-77"></span><span>    </span><span class="hs-identifier">return</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">readh</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">writeh</span><span class="hs-special">)</span><span>
</span><span id="line-78"></span><span>  </span><span class="hs-keyword">where</span><span>
</span><span id="line-79"></span><span>    </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">callStack</span><span class="hs-cpp">
#endif
</span><span class="hs-cpp">#endif
</span></pre></body></html>